home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / fulcom.zip / FULCOM.IBM next >
Text File  |  1986-09-16  |  20KB  |  464 lines
  1.  { include file FULCOM.IBM
  2.    IBM COMMUNICATIONS PROCEDURES}
  3.  
  4.  {  Gary Hartman  73537,1362}
  5.  
  6.  {
  7.  These  procedures  are  part  of  a set of two comm port include files that
  8.  are  identical  to  the  programmer, but handle the different hardware that
  9.  is  found  in  the  TI Professional computer and the IBM PC computer.  This
  10.  enables  you  to  write  a  applications  programs that can be compiled for
  11.  either machine with a simple include file substitution.
  12.  
  13.  The programmer interface includes full buffering for both Input and OUTPUT.
  14.  Output  buffering allows an applications program to output a complex screen
  15.  or  control  data  quickly,  allowing  the host computer to remain free for
  16.  use  even  if  the  selected baud rate is relative slow with respect to the
  17.  amount  of  data  output.    These procedures were originally developed for
  18.  use  in a control system program that operated a remote terminal and remote
  19.  hardware interface driven from one computer.
  20.  
  21.  Much  of  the  IBM  interrupt  procedures have been developed from the file
  22.  INTERR.INC found in CompuServe Turbo Pascal SIG. The TI Professional procedures
  23.  are  based  on  the  articles  by  Matt Lawrence  in June 1986 issue of the
  24.  magazine  TI  Professional  Computing  (Publications & Communications Inc.;
  25.  12416  Hymeadow  Drive,  Suite  Two; Austin TX 78750-1896).  The basic data
  26.  structure was based on Matt Lawrence's ideas.
  27.  
  28.  The  file  FULCOM.PAS  is  a  basic dumb-terminal program that demonstrates
  29.  the use of these procedures.
  30.  
  31.  *****************************************************************************
  32.  
  33.  
  34.  READ  THIS  READ  THIS  READ  THIS  READ THIS READ THIS READ THIS READ THIS
  35.  
  36.  
  37.  The  variables  that  are at a global level in the include file must remain
  38.  there.    Due  to  the nature of the 8088 interrupts and Turbo Pascal these
  39.  procedures must not be included inside any another procedures or functions.
  40.  
  41.  You  must  declare  outside (or include it inside this file) the following:
  42.  
  43.      type WorkLineType=string[255];
  44.  
  45.      var  RegisterSet case integer of
  46.                1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags:integer);
  47.                2: (AL,AH,BL,BH,CL,CH,DL,DH:byte);
  48.                end;
  49.           DSStorage:integer absolute CSeg:$00A0;
  50.  
  51.  The variable RegisterSet is used for DOS calls (handy for almost any program);
  52.  the type WorkLineType is use for string output; the variable DSStorage is used
  53.  to store the contents of the DS register for use by the interrupt procedures
  54.  to restore the DS register.  You must at the begining of the program make
  55.  the assignment:
  56.  
  57.                               DSStorage:=dseg;
  58.  
  59.  With  out  this  the  any  interrupt handler will not be able to access any
  60.  global variables.
  61.  
  62.  ******************************************************************************
  63.  
  64.  
  65.  USER ENTRY POINTS
  66.  
  67.  The  buffers  are  known  as  InputBuffer[Com] and OutputBuffer[Com], where
  68.  Com:byte  is the comm port number (1 or 2).  The overflow flag is addressed
  69.  as InputBuffer[Com].Over or OutputBuffer[Com].Over.
  70.  
  71.  procedure SENDSTRING(Com:byte;S:WorkLineType);
  72.  
  73.      This inserts a string of characters into the selected OutputBuffer
  74.      and initiates transmission in the transmitter is quiet.
  75.  
  76.  
  77.  function BUFFEREMPTY(B:BufferType):boolean;
  78.  
  79.      Returns  true  if  the  buffer  is  empty.   The logical value of:
  80.                   not(BUFFEREMPTY(InputBuffer[Com]))
  81.      can be compared to the keypressed function of Turbo Pascal.
  82.  
  83.  
  84.  function READBUFFER(B:BufferType):byte;
  85.  
  86.      Returns the rear of the selected buffer (usually an input buffer).
  87.      You  must check the buffer with not(BUFFEREMPTY(InputBuffer[Com]))
  88.      before  invoking  this  function.    As  written, only the lower 7
  89.      bits  are  kept on incoming data.  If you need all 8 simply remove
  90.      the "anding" of the input data with $7F in the interrupt procedures
  91.      (COMINTERRUPT1 or COMINTERRUPT2).
  92.  
  93.  
  94.  procedure INITCOM(
  95.            ComNum:byte;Baud:integer;Parity:char;WordSize:byte;StopBits:byte);
  96.  
  97.      Initiates  the  selected  comm  port to the values passed,sets the
  98.      interrupt  vector  to  point  to  the  user installed routine, and
  99.      asserts the DTR line.
  100.  
  101.  
  102.  procedure TERMINATECOM(Com:byte);
  103.  
  104.      Un-asserts  the  DTR  line  and re-installs the original interrupt
  105.      vectors for the selected comm port.
  106.  
  107.  
  108.  function CDSTATUS:boolean;
  109.  
  110.      True if the DCD (Data Carrier Detect-pin 8) is asserted; otherwise
  111.      false.
  112.  
  113.  
  114.  function CTSSTATUS:boolean;
  115.  
  116.      True  if  the  CTS  (Clear  To Send-pin 5) is asserted; otherwise
  117.      false.
  118.  
  119.  procedure TXCONTROL(Com:byte;Assert:boolean);
  120.  
  121.       Sets the DTR line accroding to Assert.
  122.  
  123.  ******************************************************************************
  124.  
  125.  }
  126.  
  127. const BufferSize=4095;
  128.  
  129. type                                        { Type declarations            }
  130.     Busy       = Array [1..2] of boolean;
  131.     BufferType=record
  132.          Head,Tail:integer;                { front, rear pointers }
  133.          Over:boolean;                     { queue error, full ect }
  134.          Data:array[0..BufferSize] of byte;
  135.          end;
  136.     ComBaseType=array[1..2] of integer;
  137.  
  138.  
  139.   CONST
  140.     irq4       = $30;                         { Interrupt vector address for }
  141.                                               { COM1.                        }
  142.     irq3       = $2C;                         { Vector for COM2.             }
  143.     ComBase:ComBaseType=($03F8,$02F8);        { port addresses               }
  144.                                               { Offset to add to com#base for}
  145.     intenreg   = 1;                           {   Interrupt enable register  }
  146.     intidreg   = 2;                           {   Interrupt id register      }
  147.     linectrl   = 3;                           {   Line control register      }
  148.     modemctrl  = 4;                           {   Modem control register     }
  149.     linestat   = 5;                           {   Line status register       }
  150.     modemstat  = 6;                           {   Modem status register      }
  151.     eoi = $20;                                { End of interrupt command     }
  152.  
  153. var
  154.     ComVecSeg,                               { Segment of DOS set           }
  155.     ComVecOff:array[1..2] of integer;        { Offset of DOS set com int.   }
  156.     Tbyte,Lbyte:integer;                     { global var for interrupt     }
  157.     ComBusy:array[1..2] of boolean;          { Comport trans busy flags     }
  158.     InputBuffer:array[1..2] of BufferType;   { input buffer                 }
  159.     OutputBuffer:array[1..2] of BufferType;  { output buffer                }
  160.  
  161. procedure COMINTERRUPT1;
  162.  
  163. begin
  164.     inline($50/$53/$51/$52/$57/$56/$06/$1E/$2E/$A1 /$A0 /$00/$50/$1F);
  165.     Lbyte:=port[ComBase[1]+intidreg];        { Get Interrupt ID             }
  166.     Lbyte:=(lbyte shr 1) and $03;            { Isolate ID bits              }
  167.     If Lbyte=1 then begin                    { Check for Transmit done      }
  168.          if OutputBuffer[1].Tail=OutputBuffer[1].Head then ComBusy[1]:=false
  169.          else begin                          { output another character    }
  170.               OutputBuffer[1].Tail:=(OutputBuffer[1].Tail+1)
  171.                    mod sizeof(OutputBuffer[1].Data);
  172.               port[ComBase[1]]:=OutputBuffer[1].Data[OutputBuffer[1].Tail];
  173.               end;
  174.          end
  175.     else if Lbyte=2 then begin                 { Check for Received Data      }
  176.          Tbyte:=port[ComBase[1]];              { Get the character in the port}
  177.          Lbyte:=port[ComBase[1]+linestat];     { Get the status of the port   }
  178.          if (InputBuffer[1].Head+1) mod sizeof(InputBuffer[1].Data)=
  179.               InputBuffer[1].Tail
  180.          then InputBuffer[1].Over:=true        { buffer overflow             }
  181.          else begin                            { put into buffer             }
  182.               InputBuffer[1].Head:=(InputBuffer[1].Head+1)
  183.                    mod sizeof(InputBuffer[1].Data);
  184.               InputBuffer[1].Data[InputBuffer[1].Head]:=Tbyte and $7F;
  185.                                                 { use only first 7 bits      }
  186.               end;
  187.          end; { lbyte = 2 }
  188.     port[$20]:=$20;                       { signal end of interrupt code }
  189.     inline($1F/$07/$5E/$5F/$5A/$59/$5B/$58/$5D/$89 /$EC/$5D/$CF );
  190.     end;  {COMINTERRUTP1}
  191.  
  192. procedure COMINTERRUPT2;
  193.  
  194. begin
  195.     inline($50/$53/$51/$52/$57/$56/$06/$1E/$2E/$A1 /$A0 /$00/$50/$1F);
  196.     Lbyte:=port[ComBase[2]+intidreg];        { Get Interrupt ID             }
  197.     Lbyte:=(lbyte shr 1) and $03;            { Isolate ID bits              }
  198.     If Lbyte=1 then begin                    { Check for Transmit done      }
  199.          if OutputBuffer[2].Tail=OutputBuffer[2].Head then ComBusy[2]:=false
  200.          else begin                          { output another character    }
  201.               OutputBuffer[2].Tail:=(OutputBuffer[2].Tail+1)
  202.                    mod sizeof(OutputBuffer[2].Data);
  203.               port[ComBase[2]]:=OutputBuffer[2].Data[OutputBuffer[2].Tail];
  204.               end;
  205.          end
  206.     else if Lbyte=2 then begin                 { Check for Received Data      }
  207.          Tbyte:=port[ComBase[2]];              { Get the character in the port}
  208.          Lbyte:=port[ComBase[2]+linestat];     { Get the status of the port   }
  209.          if (InputBuffer[2].Head+1) mod sizeof(InputBuffer[2].Data)=
  210.               InputBuffer[2].Tail
  211.          then InputBuffer[2].Over:=true        { buffer overflow             }
  212.          else begin                            { put into buffer             }
  213.               InputBuffer[2].Head:=(InputBuffer[2].Head+1)
  214.                    mod sizeof(InputBuffer[2].Data);
  215.               InputBuffer[2].Data[InputBuffer[2].Head]:=Tbyte and $7F;
  216.                                                 { use only first 7 bits      }
  217.               end;
  218.          end; { lbyte = 2 }
  219.     port[$20]:=$20;                       { signal end of interrupt code }
  220.     inline($1F/$07/$5E/$5F/$5A/$59/$5B/$58/$5D/$89 /$EC/$5D/$CF );
  221.     end;  {COMINTERRUTP2}
  222.  
  223. procedure TXCONTROL(Com:byte;Assert:boolean);
  224.  
  225. {Sets the DTR line to Assert}
  226.  
  227. var TByte:byte;
  228.  
  229. begin  {DTRSET}
  230.     inline($FA);                                  { disable interrupts    }
  231.     TByte:=Port[ComBase[Com]+ModemCtrl];          { get current state     }
  232.     if Assert then TByte:=TByte or $01            { assert DTR            }
  233.     else TByte:=TByte and $FE;                    { un-assert DTR         }
  234.     Port[ComBase[Com]+ModemCtrl]:=TByte;          { rewrite ModemCtrl Reg }
  235.     inline($FB);                                  { turn interrupts back on}
  236.     end;  {TXCONTROL}
  237.  
  238. procedure INTON(Com:byte);
  239.  
  240. const
  241.       DtrTrue=1;
  242.       RtsTrue=2;
  243.       Bit3True=8;
  244.  
  245. var
  246.       Tbyte   : byte;                         { Temperary byte buffer        }
  247.  
  248. begin  {INTON}
  249.     Tbyte:=port[ComBase[Com]];             { Read the ports to clear any  }
  250.     Tbyte:=port[ComBase[Com]+linestat ];   { error conditions             }
  251.     port[ComBase[Com]+modemctrl]:=DtrTrue+RtsTrue+Bit3True;
  252.     port[ComBase[Com]+intenreg]:=3;        { Enable com port interrupts   }
  253.     TByte:=port[$21];
  254.     with RegisterSet do begin
  255.          AX:=$2500;                          { Load the function number for }
  256.                                               { redefining an interrupt      }
  257.          DS:=cseg;                           { Get and set the segment and  }
  258.          case com of
  259.               1:dx:=ofs(COMINTERRUPT1);       { offset of the handler        }
  260.               2:dx:=ofs(COMINTERRUPT2);       { offset of the handler        }
  261.               end;
  262.          end;
  263.     case com of
  264.          1:begin
  265.               ComVecOff[1]:=memw[0000:irq4];    { Save the segment and offset }
  266.               ComVecSeg[1]:=memw[0000:irq4+2];  {of the DOS interrupt handler }
  267.               RegisterSet.AX:=RegisterSet.AX+$0C;  { Use the COM1: interrupt  }
  268.               intr($21,RegisterSet);          { Call DOS to reset INT 0C      }
  269.               port[$21]:=TByte and $EF;
  270.               end;
  271.          2:begin
  272.               ComVecOff[2]:=memw[0000:irq3]; { Same as above                }
  273.               ComVecSeg[2]:=memw[0000:irq3+2];
  274.               RegisterSet.AX:=RegisterSet.AX+$0B;{ Use the COM2: interrupt  }
  275.               intr($21,RegisterSet);         { Call DOS                     }
  276.               port[$21]:=TByte and $F7;
  277.               end;
  278.          end;
  279.     ComBusy[com]:=false;                    { Com port not busy            }
  280.     inline($FB);                            { Enable interrupts            }
  281.     end;  {INTON}
  282.  
  283. procedure CLEAR(var Buf:BufferType);
  284.  
  285. { this procedure clears a Buffer }
  286.  
  287. begin  {CLEAR}
  288.     Buf.Tail:=1;
  289.     Buf.Head:=1;
  290.     Buf.Over:=false;
  291.     end;  {CLEAR}
  292.  
  293. procedure INITCOM(Com:byte;R:integer;P:char;B:byte;S:byte);
  294.  
  295. const
  296.       Bits7=2;
  297.       Bits8=3;
  298.       Stopbit1=0;                             { These are constants used     }
  299.       Stopbit2=4;                             { to define parity, stop bits, }
  300.       Noparity=0;                             { data bits, etc.              }
  301.       Oddparity=8;
  302.       Evenparity=24;
  303.       Rate300=0;
  304.       Rate1200=64;
  305.       Rate2400=160;
  306.       Rate4800=192;
  307.       Rate9600=224;
  308.  
  309. var
  310.       Tlcr,                                   { Line control register        }
  311.       TDLmsb,                                 { Divisor latch MSB            }
  312.       TDLlsb    : byte;                       { Divisor latch LSB            }
  313.       Bits      : integer;                    { No of bits per char          }
  314.       StopBits  : integer;                    { No of stop bits per char     }
  315.       SetParity : integer;                    { parity mode even, odd , none }
  316.  
  317. begin   {INITCOM}
  318.     TDLmsb:=0;                                { Set DL MSB to 0 for 1200,    }
  319.                                               { 2400, 4800 and 9600 baud     }
  320.     case R of                                 { Use case to check baud rate  }
  321.          300:begin                            { Check for 300 baud           }
  322.               TDLmsb:=1;                      { Set DL MSB to 01             }
  323.               TDLlsb:=$80;                    { Set DL LSB to 80             }
  324.               end;                            { for a total of 0180          }
  325.         1200:TDLlsb:=$60;                     { 1200 set LSB to 60           }
  326.         2400:TDLlsb:=$30;                     { 2400 set LSB to $30          }
  327.         4800:TDLlsb:=$18;                     { 4800 set LSB to 18           }
  328.         9600:TDLlsb:=$0c;                     { 0C for 9600 baud             }
  329.         end;
  330.     case P of                                 { use case to check parity     }
  331.          'E'     : setparity:=evenparity;     { set for even parity          }
  332.          'O'     : setparity:=oddparity;      { set for odd parity           }
  333.          'N'     : setparity:=noparity;       { set for no parity            }
  334.          else SetParity:=NoParity;            { default is no parity         }
  335.          end;
  336.     case S of                                 { use case for stopbits        }
  337.          1:StopBits:=Stopbit1;                { one stopbit                  }
  338.          2:stopbits:=Stopbit2;                { two stopbits                 }
  339.          else Stopbits:=Stopbit1;             { default to 1 stopbit         }
  340.          end;
  341.     case B of                                 { use case for bits per char   }
  342.          8:Bits:=bits8;                       { set to eight bits            }
  343.          7:Bits:=bits7;                       { set to seven bits            }
  344.          else bits:=bits8;                    { default to eight bits        }
  345.          end;
  346.     inline($FA);                              { disable interupts            }
  347.     Tlcr:=port[ComBase[Com]];                 { read the port to clear any   }
  348.     Tlcr:=port[ComBase[Com]+LineStat];        { error condition              }
  349.     port[ComBase[Com]+LineCtrl]:=Bits+StopBits+SetParity; { Set parameters   }
  350.     Tlcr:=port[ComBase[Com]+Linectrl];        { Get the Line control register}
  351.     port[ComBase[Com]+linectrl]:=tlcr or $80; { Set Div Latch Access Bit     }
  352.     port[ComBase[Com]]:=TDLlsb;               { in order to access divisor   }
  353.     port[ComBase[Com]+1]:=TDLmsb;             { latches, then store values   }
  354.     port[ComBase[Com]+LineCtrl]:=Tlcr and $7F;{ clear the DLAB               }
  355.     inline($FB);                              { interupts on                 }
  356.     CLEAR(InputBuffer[Com]);                  { clear the buffers            }
  357.     CLEAR(OutputBuffer[Com]);
  358.     INTON(Com);                               { establish our vectors        }
  359.     TXCONTROL(Com,true);                      { assert DTR                   }
  360.     end;      {INITCOM}
  361.  
  362. procedure TERMINATECOM(Com:byte);
  363.  
  364. var
  365.       TByte:byte;
  366.  
  367. begin
  368.     TXCONTROL(Com,false);
  369.     inline($FA);  { CLI }                   { Disable interrupts           }
  370.     TByte:=port[$21];                       {                              }
  371.     port[ComBase[Com]+IntenReg]:=0;         { Disable COM interrupts       }
  372.     if Com=1 then port[$21]:=TByte or $10   { turn off interrupt control}
  373.     else port[$21]:=TByte or $08;
  374.     memw[0000:irq4]:=ComVecOff[Com];        { Restore the DOS interrupt    }
  375.     memw[0000:irq4+2]:=ComVecSeg[Com];      { handler                      }
  376.     ComBusy[Com]:=true;
  377.     inline($FB);
  378.     end;
  379.  
  380. function BUFFERFULL(var Buf:BufferType):boolean;
  381.  
  382. { this fuction tests to see it the queue is full }
  383.  
  384. var Temp:integer;
  385.  
  386. begin
  387.     Temp:=(Buf.Head+1) mod sizeof(Buf.Data);
  388.     BufferFull:=(Temp=Buf.Tail);
  389.     end;
  390.  
  391. function BUFFEREMPTY(var Buf:BufferType):boolean;
  392.  
  393. { this function test to see if the queue is empty }
  394.  
  395. begin
  396.     BUFFEREMPTY:=Buf.Tail=Buf.Head;
  397.     end;
  398.  
  399. procedure WRITEBUFFER(var Buf:BufferType;var Input:char);
  400.  
  401. { this procedure adds an entry to the queue at the rear }
  402.  
  403. var Temp:integer;
  404.  
  405. begin
  406.    if BUFFERFULL(Buf) then Buf.Over:=true          {overflow condition }
  407.    else begin                                      { there is room}
  408.          Temp:=(Buf.Head+1) mod sizeof(Buf.Data);
  409.          Buf.Data[Temp]:=ord(Input);
  410.          Buf.Head:=Temp;
  411.          end;
  412.     end;  {BUFFERWRITE}
  413.  
  414. function READBUFFER(var Buf:BufferType):byte;
  415.  
  416. { this procedure removes an entry from the queue at the front }
  417.  
  418. begin
  419.     Buf.Tail:=(Buf.Tail+1) mod sizeof(Buf.Data);
  420.     ReadBuffer:=Buf.Data[Buf.Tail];
  421.     end;
  422.  
  423. procedure SENDSTRING(Com:byte;S:WorkLineType);
  424.  
  425. { this is the main output routine, which sends a string  }
  426.  
  427. var I,J:byte;
  428.  
  429. begin
  430.     J:=ord(S[0]);                              { get length of string }
  431.     for I:=1 to J do WRITEBUFFER(OutputBuffer[Com],S[I]); {output to buf}
  432.     if not(ComBusy[Com]) and not(BUFFEREMPTY(OutputBuffer[Com]))
  433.     then begin                { tickle the transmitter to start output}
  434.          ComBusy[Com]:=true;
  435.          port[ComBase[Com]]:=READBUFFER(OutputBuffer[Com]);
  436.          end;
  437.     end;   {SENDSTRING}
  438.  
  439. function DCDSTATUS(Com:byte):boolean;
  440.  
  441. { Returns the stats of the carier detect line }
  442.  
  443. begin  {DCDSTATUS}
  444.     with RegisterSet do begin
  445.          AH:=$03;
  446.          DX:=pred(Com);
  447.          intr($14,RegisterSet);
  448.          DCDStatus:=(AL and $80)=$80;
  449.          end;
  450.     end;  {DCDSTATUS}
  451.  
  452. function CTSSTATUS(Com:byte):boolean;
  453.  
  454. { returns the status of the clear to send line}
  455.  
  456. begin  {CTSSTATUS}
  457.     with RegisterSet do begin
  458.          AH:=$03;
  459.          DX:=pred(Com);
  460.          intr($14,RegisterSet);
  461.          CTSStatus:=(AL and $10)=$10;
  462.          end;
  463.     end;  {CTSSTATUS}
  464.